home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)abj.d64 / address list (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  5KB  |  215 lines
  1. 0 REM******* BUCK'S ADDRESS LIST *****
  2. 1 IFA=0THENA=1:LOAD"ADDRESS LIST M/L",8,1
  3. 5 TI$="000000":SYS30120:POKE53281,0:POKE53280,0:CLR
  4. 10 IFVAL(TI$)>210THENTI$="000000":SYS30120
  5. 15 PRINTCHR$(147):RESTORE
  6. 20 PRINTTAB(10)"[152]*** ADDRESS FILE [146]***"
  7. 25 PRINT"":FOR A=1TO3:READ M$
  8. 30 PRINTTAB(10);"";A;"- ";M$
  9. 35 NEXT A
  10. 40 PRINTTAB(10)" CHOOSE BY NUMBER [146]"
  11. 45 GET A$:A=VAL(A$):IF A<1 THEN 45
  12. 50 ON A GOTO 95, 135, 85
  13. 55 GOTO 45
  14. 60 DATA INPUT DATA,READ DATA,QUIT,ADD ENTRIES
  15. 65 DATA CHANGE ENTRY,DELETE ENTRY
  16. 70 DATA START NEW FILE,DESTROY FILE,GO TO MAIN MENUE
  17. 75 DATA READ ALL ENTRIES,READ BY LAST NAME,READ BY FIRST NAME
  18. 80 DATA READ SINGLE ENTRY,GO TO MAIN MENUE
  19. 85 IF PT%>0 THENGOSUB 740
  20. 90 SYS770
  21. 95 PRINT CHR$(147)
  22. 100 PRINTTAB(10)"*** ADDRESS FILE [146]***"
  23. 105 PRINT"":FOR A=1TO6:READ M$
  24. 110 PRINTTAB(10);"";A;"- ";M$
  25. 115 NEXT A
  26. 120 PRINTTAB(10)" CHOOSE BY NUMBER [146]"
  27. 125 GET A$:A=VAL(A$):IF A<1 THEN 125
  28. 130 ON A GOTO 235, 405, 480, 185, 205, 10
  29. 135 FOR A=1 TO 6:READ M$:NEXT A
  30. 140 PRINTCHR$(147)
  31. 145 PRINTTAB(10)"*** ADDRESS FILE [146]***"
  32. 150 PRINT"":FOR A=1TO5:READ M$
  33. 155 PRINTTAB(10);"";A;"- ";M$
  34. 160 NEXT A
  35. 165 PRINTTAB(10)" CHOOSE BY NUMBER [146]"
  36. 170 GET A$:A=VAL(A$):IF A<1 THEN 170
  37. 175 ON A GOTO 275, 315, 310, 305, 10
  38. 180 REM***** START FILE ***************
  39. 185 OPEN15,8,15,"I0"
  40. 190 OPEN2,8,2,"0:ADDRESS FILE,S,W"
  41. 195 PRINT#2,0:CLOSE2:CLOSE15:GOTO 10
  42. 200 REM***** DESTROY FILE *************
  43. 205 PRINT"[147]ARE YOU SURE YOU WANT TO DESTROY"
  44. 210 PRINT"YOUR ENTIRE ADDRESS FILE ?????(Y/N)"
  45. 215 GETA$:IFA$=""THEN 215
  46. 220 IFA$="Y"THENOPEN15,8,15,"S0:ADDRESS FILE":CLOSE15:GOTO 10
  47. 225 IFA$<>"N"THEN 215
  48. 230 GOTO 10
  49. 235 REM*** ADD TO FILE ****************
  50. 240 IF PT%>0 THENGOSUB 740
  51. 245 IF IP%=1 THENCLR
  52. 250 PRINT CHR$(147):PRINT:PRINT
  53. 255 INPUT"  NUMBER OF NAMES TO ADD";NE%
  54. 260 GOSUB 625
  55. 265 FOR X=N%+1TON:GOSUB 565:NEXT X
  56. 270 PT%=1:GOSUB 875:GOTO 10
  57. 275 REM*** READ SUBROUTINE ************
  58. 280 GOSUB 625:FOR X=1TON
  59. 285 IF DA$(X,1)="\X"THEN 295
  60. 290 GOSUB 820
  61. 295 NEXT X:GOTO 10
  62. 300 REM*** SEARCH SUBROUTINE **********
  63. 305 L%=1:GOTO 315
  64. 310 F%=1
  65. 315 GOSUB 625
  66. 320 PRINT CHR$(147):PRINT:PRINT
  67. 325 PRINT"       NAME TO FIND ":PRINT
  68. 330 IF F%=1 THENNA$="":GOTO 345
  69. 335 INPUT"  LAST NAME";NA$
  70. 340 IF F%=0ANDL%=0THENNL$="":GOTO 350
  71. 345 PRINT:INPUT"  FIRST NAME ";NL$
  72. 350 FOR X=1TON
  73. 355 IF F%=0 THENGOTO 365
  74. 360 IF DA$(X,2)=NL$ OR DA$(X,3)=NL$ THENGOTO 390
  75. 365 IF DA$(X,1)<>NA$ THEN 395
  76. 370 IF L%=1 THEN 385
  77. 375 IF L%=0 THEN 390
  78. 380 IF F%=O THEN 390
  79. 385 IF DA$(X,2)<>NL$ THEN 395
  80. 390 GOSUB 820
  81. 395 NEXT X:L%=0:F%=O
  82. 400 GOTO 10
  83. 405 REM*** CHANGE SUBROUTINE **********
  84. 410 GOSUB 625
  85. 415 PRINT CHR$(147):PRINT:PRINT
  86. 420 PRINT"  NAME TO CHANGE  "
  87. 425 PRINT:INPUT"  LAST NAME  ";NA$
  88. 430 PRINT:INPUT"  FIRST NAME ";NL$
  89. 435 FOR X=1TON
  90. 440 IF DA$(X,1)<>NA$ THEN 470
  91. 445 IF DA$(X,2)<>NL$ THEN 470
  92. 450 FORY=1TO8:PRINTTAB(7);" ";DA$(X,Y)
  93. 455 INPUT "[145]";DA$(X,Y)
  94. 460 GOSUB 1015
  95. 465 NEXT Y
  96. 470 NEXT X
  97. 475 PT%=1:GOTO 10
  98. 480 REM*** DELETE SUBROUTINE **********
  99. 485 PRINTCHR$(147):PRINT:PRINT
  100. 490 PRINT"  ENTER NAME TO DELETE":PRINT
  101. 495 INPUT"  LAST NAME";NA$
  102. 500 PRINT:INPUT"  FIRST NAME ";NN$
  103. 505 GOSUB 625
  104. 510 FOR X=1TON
  105. 515 IF DA$(X,1)<>NA$ THEN 560
  106. 520 IF DA$(X,2)<>NN$ THEN 560
  107. 525 GOSUB 820
  108. 530 PRINT"  IS THIS THE ENTRY TO DELETE? (Y/N)"
  109. 535 GET AN$
  110. 540 IF AN$="N" THEN 10
  111. 545 IF AN$<>"Y" THEN 535
  112. 550 DA$(X,1)="\X"
  113. 555 PT%=2:D%=D%+1
  114. 560 NEXT X:GOTO 10
  115. 565 REM*** INPUT SUBROUTINE ***********
  116. 570 PRINT CHR$(147):PRINT:PRINT
  117. 575 PRINT"  ENTRY #";X-N%:PRINT
  118. 580 Y=1:INPUT" LAST NAME......";DA$(X,Y):GOSUB 1015
  119. 585 Y=2:INPUT" FIRST NAME.....";DA$(X,Y):GOSUB 1015
  120. 590 Y=3:INPUT" SPOUSE'S NAME..";DA$(X,Y):GOSUB 1015
  121. 595 Y=4:INPUT" ADDRESS........";DA$(X,Y):GOSUB 1015
  122. 600 Y=5:INPUT" CITY...........";DA$(X,Y):GOSUB 1015
  123. 605 Y=6:INPUT" STATE..........";DA$(X,Y):GOSUB 1015
  124. 610 Y=7:INPUT" ZIP CODE.......";DA$(X,Y):GOSUB 1015
  125. 615 Y=8:INPUT" PHONE #........";DA$(X,Y):GOSUB 1015
  126. 620 RETURN
  127. 625 REM*** INPUT# SUBROUTINE **********
  128. 630 PRINT"[147]"
  129. 635 PRINTTAB(12)" LOADING FILE [146]"
  130. 640 IF IP%=1 THENRETURN
  131. 645 OPEN15,8,15,"I0"
  132. 650 OPEN2,8,2,"0:ADDRESS FILE,S,R"
  133. 655 INPUT#15,E1$,E2$,E3$,E4$
  134. 660 IF VAL(E1$)>0 THENCLOSE2:CLOSE15:GOSUB 715:GOTO 625
  135. 665 INPUT#2,N%
  136. 670 N=N%+NE%
  137. 675 DIM DA$(N+2,8)
  138. 680 IF N%=0 THEN 705
  139. 685 FOR X=1TON%:FOR Y=1TO8
  140. 690 INPUT#2,DA$(X,Y)
  141. 695 POKE53280,CL:CL=CL+1:IFCL>16THENCL=0
  142. 700 NEXT Y:NEXT X
  143. 705 CLOSE2:CLOSE15
  144. 710 POKE53280,0:IP%=1:RETURN
  145. 715 PRINT"[147]",E2$
  146. 720 IFE2$="FILE NOT FOUND"THENPRINT" MAYBE YOU NEED TO START NEW FILE"
  147. 725 IFE2$="FILE NOT FOUND"THENPRINT"RUN 10[145][145][145][145]":STOP
  148. 730 PRINT" CORRECT ERROR AND HIT RETURN [146]"
  149. 735 PRINT"CONT[145][145][145][145]":STOP:RETURN
  150. 740 REM*** PRINT# SUBROUTINE **********
  151. 745 PRINT"[147]"
  152. 750 PRINTTAB(12)" SAVING FILE [146]"
  153. 755 OPEN15,8,15,"I0"
  154. 760 OPEN2,8,2,"@0:ADDRESS FILE,S,W"
  155. 765 INPUT#15,E1$,E2$,E3$,E4$
  156. 770 IF VAL(E1$)>0 THENCLOSE2:CLOSE15:GOSUB 715:GOTO 740
  157. 775 Q%=N-D%
  158. 780 PRINT#2,Q%;CHR$(13);
  159. 785 FOR X=1TON:FOR Y=1TO8
  160. 790 IF DA$(X,1)="\X"THEN 810
  161. 795 PRINT#2,DA$(X,Y)
  162. 800 POKE53280,CL:CL=CL+1:IFCL>16THENCL=0
  163. 805 NEXT Y
  164. 810 NEXT X
  165. 815 POKE53280,0:CLOSE2:CLOSE15:RETURN
  166. 820 REM******PRINT ROUTINE************
  167. 825 PRINT CHR$(147):PRINT""
  168. 830 PRINTTAB(10);DA$(X,1);", ";DA$(X,2);" & ";DA$(X,3)
  169. 835 PRINTTAB(10);DA$(X,4)
  170. 840 PRINTTAB(10);DA$(X,5);", ";DA$(X,6);"  "DA$(X,7)
  171. 845 PRINTTAB(10);DA$(X,8)
  172. 850 PRINTTAB(13);"<HIT ANY KEY>"
  173. 855 PRINTTAB(10);"<HIT 'P' FOR PRINT>"
  174. 860 GET AN$:IF AN$="" THEN 860
  175. 865 IF AN$="P" THENGOSUB 940
  176. 870 RETURN
  177. 875 REM ********SORT****************
  178. 880 IFN<=2THENRETURN
  179. 885 PRINT"[147]":PRINTTAB(12)" SORTING FILE [146]"
  180. 890 DIM SW$(2,8)
  181. 895 FOR X=1 TO N
  182. 900 FOR S=NTOX+1 STEP-1:POKE53280,CL:CL=CL+1:IFCL>16THENCL=0
  183. 905 IFDA$(X,1)+DA$(X,2)<=DA$(S,1)+DA$(S,2) THEN 935
  184. 910 FORY=1TO8:SW$(1,Y)=DA$(S,Y):NEXTY
  185. 915 FORZ=S-1TOXSTEP-1:FORY=1TO8
  186. 920 DA$(Z+1,Y)=DA$(Z,Y):NEXTY:NEXTZ
  187. 925 FORY=1TO8:DA$(X,Y)=SW$(1,Y):NEXTY
  188. 930 S=S+1
  189. 935 NEXT S:NEXT X:POKE53280,0:RETURN
  190. 940 REM ******** PRINTER OUTPUT *****
  191. 945 OPEN4,4
  192. 950 PRINT"1ST 2ND OR BOTH NAMES (1 2 OR B) ?"
  193. 955 GETA$:IFA$=""THEN 955
  194. 960 INPUT"HOW MANY";LA%
  195. 965 FORZZ=1TOLA%
  196. 970 IFA$="1"THEN 990
  197. 975 IFA$="2"THEN 985
  198. 980 PRINT#4,DA$(X,2);" & ";DA$(X,3);" ";DA$(X,1):GOTO 995
  199. 985 PRINT#4,DA$(X,3);" ";DA$(X,1):GOTO 995
  200. 990 PRINT#4,DA$(X,2);" ";DA$(X,1)
  201. 995 PRINT#4,DA$(X,4)
  202. 1000 PRINT#4,DA$(X,5);",";DA$(X,6);" ";DA$(X,7)
  203. 1005 FORPR=1TO3:PRINT#4:NEXTPR:PRINT" ";ZZ:NEXTZZ
  204. 1010 CLOSE4:X=X-1:RETURN
  205. 1015 REM*****************************
  206. 1020 REM*** CHECK ENTRY *************
  207. 1025 REM*****************************
  208. 1030 IF DA$(X,Y)=""THEN 1060
  209. 1035 FORCK=1TO(LEN(DA$(X,Y)))
  210. 1040 CK$=MID$(DA$(X,Y),CK,1)
  211. 1045 IFCK$=","ORCK$=";"ORCK$=":"THEN 1060
  212. 1050 NEXT CK
  213. 1055 RETURN
  214. 1060 DA$(X,Y)="ERROR":RETURN
  215.